home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / examples / lexyacc / cl / edigits.cl < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.0 KB  |  65 lines  |  [TEXT/R*ch]
  1. (* Translated from Gofer demos/examples.gs: Digits of e
  2.  
  3. eFactBase ::  [Int]
  4. eFactBase  =  map head (iterate scale (2:repeat 1))
  5.  
  6. scale      =  renorm . map (10* ) . tail
  7. renorm ds  =  foldr step [0] (zip ds [2..])
  8.  
  9. step (d,n) bs | (d `mod` n + 9) < n  = (d/n) : b : tail bs
  10.               | otherwise            = c     : b : tail bs
  11.               where b' = head bs
  12.                     b  = (d+b') `mod` n
  13.                     c  = (d+b') `div` n
  14. *)
  15.  
  16. letrec 
  17.   eFactBase = map head (iterate scale pack{2, 2, repeat 1});
  18.   scale = compose (compose renorm (map (\n.10*n))) tail;
  19.   renorm = \ds. foldr step pack{2, 0, pack{1}} (zip ds (from 2));
  20.   step = \dn.\bs. 
  21.          case dn of
  22.            <1> d n -> letrec 
  23.                         bp = head bs;
  24.                         b  = (d+bp) % n;
  25.                         c  = (d+bp) / n
  26.                       in pack{2, if (d % n + 9) < n then d/n else c,
  27.                                  pack{2, b, tail bs}}
  28.          end;
  29.   map = \f.\xs. case xs of
  30.                   <1>      -> pack{1};
  31.                   <2> x xr -> pack{2, f x, map f xr}
  32.                 end; 
  33.   take = \n.\xs.case xs of
  34.                   <1>      -> pack {1} ;
  35.                   <2> x xr -> if n=0 then pack {1}
  36.                               else pack {2, x, take (n-1) xr}
  37.                 end;
  38.   compose = \f.\g.\x. f(g x);
  39.   head = \xs. case xs of
  40.                 <1>      -> 0;
  41.                 <2> x xr -> x
  42.               end;
  43.   tail = \xs. case xs of
  44.                 <1>      -> pack{1};
  45.                 <2> x xr -> xr
  46.               end;
  47.   zip = \xs.\ys.
  48.         case xs of
  49.           <1>      -> pack{1};
  50.           <2> x xr -> case ys of
  51.                         <1>      -> pack{1};
  52.                         <2> y yr -> pack{2, pack{1, x, y}, zip xr yr}
  53.                   end
  54.         end;
  55.   foldr = \f.\z.\xs.
  56.           case xs of
  57.             <1>      -> z;
  58.             <2> x xr -> f x (foldr f z xr)
  59.           end; 
  60.   iterate = \f.\x. pack{2, x, iterate f (f x)};
  61.   repeat = \x.letrec xs = pack{2, x, xs} in xs;
  62.   from = \n. pack{2, n, from (n+1)}
  63. in take 100 eFactBase
  64.  
  65.